perm filename LNEND.F4[P11,LCS] blob
sn#579534 filedate 1981-04-15 generic text, type T, neo UTF8
C***** LNEND, BARS, SCAN2, SCAN3, SCAN4
SUBROUTINE LNEND
COMMON/ALF/JNP(72),ML/MKX/LSL
1 /SCX/JALPHA(30),JX,RA,JZ,IRHY,RB,KA,KB,IZ
1 /JCHAR/IXX,ISEMI,JBLA,IG
EQUIVALENCE (LST,JALPHA(8)),(LCM,JALPHA(10))
K=1
C IF BAD INPUT PUT ISEMI INTO ALF(4) [JNP1] AT END
C LST * SCX+7
C LCM ;
C LSL /
K3=1
K5=72
2901 IF(LSL.NE.JNP(K3))GO TO 2903
K=K3
GO TO 2902
2903 IF(LCM.NE.JNP(K3))GO TO 2902
JNP(K3)=LST
RETURN
2902 K3=K3+1
IF(K3.LE.K5)GO TO 2901
JNP(K)=LCM
C GET LOC. OF LAST /
END
SUBROUTINE BARS
COMMON /ALF/INP(72),ML /SC/J,LSC,MK
1 ,ISKP,XMINUS,N,REXP,LK,NNUM,JJ,JN,DBST,NFLG,JXX,JSEMI,QQ
1 ,VX(50),IAMP,K,RRN,M,MODE,IBLA
COMMON/A2Z/LAA,LBB,LCC,LDD,LEE,LFF,LGG,LHH,LII,LJJ,LKK,LEL,LMM
1 ,LNN,LOH,LPP,LQQ,LRR,LSS,LTT,LUU,LVV,LWW,LXX,LYY,LZZ
C ***** BARS =4000 ****** ; THE 1 IS FOR BAR ONE STAFF ONLY.
QZ=4001.
2002 JN=INP(ML)
IF(JN.EQ.LDD)GO TO 3002
IF(JN.NE.LMM)GO TO 23
VX(1)=VX(1)+1.
ML=ML+1
GO TO 2002
C GO BACK AND LOOK FOR MORE M'S ML=ML+1
3002 ML=ML+1
C FOUND 'MDN' -- FOR DOUBLE BARS
JN=0
QZ=-QZ
C DBL BARS ARE NEG.
23 VX(1)=QZ
K=NALF(INP(ML))
IF(K.LE.0)RETURN
IF(K.GT.9)RETURN
C NO MORE THAN 8 STAVES UP ALLOWED.
K=K-1
C BECAUSE ORIG. NUM WAS 4001, NOT 4000
IF(JN.EQ.0)K=-K
C NEG. IF DBL BAR
VX(1)=VX(1)+K
C 'M2'= A BAR LINE UP 2 STAVES. ETC.
END
SUBROUTINE SCAN2(QZ)
C FOR METER(Tm n), STEM DIR.(SU,SD), STAFF UP-DN
COMMON /ALF/INP(72),ML /SC/J,LSC,MK
1 ,ISKP,XMINUS,N,REXP,LK,NNUM,JJ,JN,DBST,NFLG,JXX,JSEMI,QQ
1 ,VX(50),IAMP,K,RRN,M,MODE,IBLA
COMMON/A2Z/LAA,LBB,LCC,LDD,LEE,LFF,LGG,LHH,LII,LJJ,LKK,LEL,LMM
1 ,LNN,LOH,LPP,LQQ,LRR,LSS,LTT,LUU,LVV,LWW,LXX,LYY,LZZ
4 IF(K.NE.20)GO TO 21
QZ=-1
C TRY AGAIN IF NOT A 'T'
IF(INP(ML).GT.0)RETURN
C T12,8/ ETC. MAKES A METR, OR TIM SIG. POS NUMS AREN'T LETRS!
C ***** CLEFS = 3000 ***** CODE 3.
QZ=3000.
IF(INP(ML).EQ.LEE)QZ=QZ+3.
C TENOR CLEF =3003, TREBLE=3000
RETURN
C NOT AN 'S'(STEM OR STAFF), UNKNOWN ITEM, SKIP IT.
21 KI=INP(ML)
C SU UP=5010
QQ=0
IF(KI.EQ.LUU)QQ=10.
IF(KI.EQ.LDD)QQ=20.
C DOWN = 5020
IF(KI.EQ.'+')QQ=2.
C S+=5002
IF(KI.EQ.'-')QQ=1.
C S-=5001
C S0=5000
C THESE ARE FOR S+, S-, S0; PUT NOTE ON OTHER STF.
VX(1)=5000.+QQ
QZ=0
END
SUBROUTINE SCAN3(NSWCH)
C FOR NOTE NAMES.
COMMON /ALF/INP(72),ML /SC/J,LSC,MK
1 ,ISKP,XMINUS,N,REXP,LK,NNUM,JJ,JN,DBST,NFLG,JXX,JSEMI,QQ
1 ,VX(50),IAMP,K,RRN,M,MODE,IBLA
COMMON/A2Z/LAA,LBB,LCC,LDD,LEE,LFF,LGG,LHH,LII,LJJ,LKK,LEL,LMM
1 ,LNN,LOH,LPP,LQQ,LRR,LSS,LTT,LUU,LVV,LWW,LXX,LYY,LZZ
6 K=K-2
C -2 BECAUSE MUSICAL ALPHABET STARTS WITH C
IF(K.LE.0)K=K+7
NNUM=K
KQ=1000
K=1
IF(NNUM.GT.3)K=K+1
C FOUND A NOTE
IF(N.EQ.JXX)GO TO 5410
C FOR GX3/ ETC.
IF(N.NE.INP(ML-1))GO TO 66
C NO DOUBLE-LETTER ACCID. (FLAT)
IF(N.NE.INP(ML+1))GO TO 88
C NO TRIPLE-LETTER ACCID. (SHARP)
ML=ML+1
IF(N.NE.INP(ML+1))GO TO 8
C NO TRIPLE-LETTER ACCID. (NATURAL)
ML=ML+1
KQ=1300
C TYPE AA FOR AF, AAA = AS, AAAA = AN
GO TO 610
66 K=NALF(N)
IF(N.GT.0)GO TO 7
C JUMP IF NOT A LETTER
KQ=1300
C ; ***** NOTES ***** =1000 2ND DIG=ACCI.
IF(K.EQ.22)GO TO 610
C *** CAN USE 'V' FOR NATURAL(EASIER TO HIT!!)
IF(K.EQ.14)GO TO 610
C JUMP IF NATURAL
IF(K.EQ.19)GO TO 8
C -- S --
88 KQ=1100
C IT'S A FLAT
GO TO 610
8 KQ=1200
C SHARP =1200
610 ML=ML+1
NK=INP(ML)
K=NALF(NK)
IF(NK.GE.0)GO TO 7
C IF CHAR. ISN'T A LETTER, GO TO S7
C (LETTERS ARE NEG., NUMBS ARE POS.)
IF(K.NE.19)GO TO 777
C IF(K.EQ.19) THEN IT'S SS
C FOR DBL FLAT, DBL SHARP
KQ=1500
C DBL FLAT
GO TO 610
777 IF(K.NE.6)GO TO 7
C IS IT 'FF'?
KQ=1400
C FF=1400, SS=1500
GO TO 610
C GO BACK FOR ANOTHER CHAR.
7 IF(K.EQ.11)GO TO 5410
C IS IT 'K'?
IF(K.LT.0)GO TO 5410
C IF SEMICOLON OR BLANK
IF(K.NE.24)GO TO 24
C IS IT 'X'?
GO TO 5410
24 JSCA=K
C SAVE OCT. NUM
ML=ML+1
GO TO 2410
5410 IF(NSWCH.EQ.0)GO TO 2410
JJ=NOLD-NNUM
IF(JJ.GE.4)JSCA=JSCA+1
IF(JJ.LE.-4)JSCA=JSCA-1
C WILL JUMP TO NEAREST NOTE (DIATONIC-'75)
2410 JJ=1
VX2=0
QQ=JSCA*7+NNUM+KQ
VX(1)=QQ*DBST
C DOUBLE STOPS ARE NEG. NnUMBERS
NOLD=NNUM
C ABOVE FINDS SCALE NOTES; IF NSWCH=0 OCT. NUM WILL STICK UNTIL RESET
END
SUBROUTINE SCAN4
C FOR KEY SIGS.
COMMON /ALF/INP(72),ML /SC/J,LSC,MK
1 ,ISKP,XMINUS,N,REXP,LK,NNUM,JJ,JN,DBST,NFLG,JXX,JSEMI,QQ
1 ,VX(50),IAMP,K,RRN,M,MODE,IBLA
COMMON/A2Z/LAA,LBB,LCC,LDD,LEE,LFF,LGG,LHH,LII,LJJ,LKK,LEL,LMM
1 ,LNN,LOH,LPP,LQQ,LRR,LSS,LTT,LUU,LVV,LWW,LXX,LYY,LZZ
QQ=17000.
CC**** NUM FOR KEY SIGS ***
18 N=INP(ML)
ML=ML+1
IF(N.EQ.IBLA)GO TO 18
IF(N.NE.LNN)GO TO 200
C IS IT AN N? K3FN/ OR K2SN/ MAKES NATURALS
C IF NEXT CHAR='N' A 'NATURALS' KEY SIG.
QZ=100.
IF(QQ.LE.0)QZ=-QZ
QQ=QQ+QZ
GO TO 18
200 IF(N.EQ.LSS)GO TO 18
IF(N.EQ.'+')GO TO 18
IF(N.EQ.JSEMI)GO TO 20
IF(N.EQ.'-')N=LFF
IF(N.NE.LFF)GO TO 19
QQ=-QQ
C NEG. FOR FLATS
GO TO 18
19 A=NALF(N)
GO TO 18
C GO BACK AND LOOK AGAIN
20 IF(QQ.LT.0)A=-A
VX(1)=QQ+A
C KSIG
END